perm filename CMANDS[G,BGB]1 blob
sn#020184 filedate 1973-01-15 generic text, type T, neo UTF8
00100 ;GEOMETRIC EDITOR COMMAND EXECUTION.
00200 ;WING OPERATIONS.
00300 ; EXTERN MAKE,KILL
00400 EXTERN MKB,MKF,MKE,MKV,MKBFV
00500 EXTERN KLB,KLF,KLE,KLV,WING
00600 EXTERN WING,LINKED
00700 EXTERN ECW,ECCW,OTHER,OTHER.
00800 EXTERN BODY,FCW,FCCW,VCW,VCCW
00900 ;EULER OPERATIONS.
01000 EXTERN MKEV
01100
01200
01300 ;1. "V"-COMMAND. MAKE VERTEX BODY.
01400 SUBR(VBODY)-------------------------------------------------------
01500 BEGIN VBODY;BGB 13 JANUARY 1973.
01600 A←1↔B←2↔C←3
01700 CALL(MKBFV)
01800 LAC B,PDLPTR
01900 PUSH B,A
02000 PFACE 0,A↔PUSH B,0
02100 PVT 0,A↔PUSH B,0
02200 DAC B,PDLPTR
02300 POP0J
02400 BEND;1/14/72------------------------------------------------------
00100 ;2. "E"-COMMAND. SWEEP WIRE.
00200 SUBR(SWIRE)-------------------------------------------------------
00300 BEGIN SWIRE;BGB 14 JANUARY 1973.
00400 PTR←16
00500 CDR PTR,PDLPTR↔CAIG PTR,PADPDL↔POP0J ;PADPDL EMPTY.
00600 CALL(LINKED,{-1(PTR)},{(PTR)}) ;ILLEGAL ARGS.
00700 SKIPN 1↔POP0J↔LAC PTR,PDLPTR
00800 CALL(MKEV,{-1(PTR)},{(PTR)})
00900 LAC PTR,PDLPTR↔DAC 1,(PTR)↔POP0J ;REPLACE TOP.
01000 BEND;1/14/72------------------------------------------------------
00100 ;3. ":;()-*" COMMANDS. EUCLIDEAN TRANSFORMATION COMMANDS.
00200 SUBR(EUTRAN)------------------------------------------------------
00300 BEGIN EUTRAN;BGB 15 JANUARY 1973.
00400
00500 CDR 1,PDLPTR↔CAIGE 1,PADPDL↔POP0J
00600 LAC(1)↔DAC OBJECT
00700
00800 ;OPERATION CODE.
00900 SETZ
01000 SKIPE CTRL↔IORI 100
01100 SKIPE META↔IORI 200
01200 SKIPN↔IORI OPERAT ;DEFAULT OPERATION.
01300 ;AXIS CODE.
01400 LAC 1,CHR
01500 CAIE 1,"("↔CAIN 1,")"↔IORI 010
01600 CAIE 1,"-"↔CAIN 1,"*"↔IORI 020
01700 ;AXIS MODIFIER.
01800 IOR AXECNT↔DAC OPAXCNT
01900 ;DELTA ARGUMENT.
02000 LAC 2,TDEL↔TRNE 100↔LAC 2,RDEL↔TRNE 200↔LAC 2,DDEL
02100 CAIN 1,"-"↔MOVNS 2
02200 CAIN 1,"("↔MOVNS 2
02300 CAIN 1,";"↔MOVNS 2
02400
02500 ;GET REFERENCE FRAME.
02600
02700 ;MAKE EUCLIDEAN TRANSFORMATION.
02800 SETQ(TRAN,{MKTRAN,REFRAM,OPAXCNT,DELTA})
02900
03000 ;APPLY EUCLIDEAN TRANSFORMATION.
03100
03200 L: CALL(APTRAN,OBJECT,TRAN)
03300 CALL(DPYSUB)
03400 SOSLE COUNT↔GO L
03500
03600 DECLARE{OBJECT,TRAN,REFRAM,OPAXCNT,DELTA,COUNT}
03700 BEND;1/15/72------------------------------------------------------